home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Contributed Scores / Mary Beth / make-beth-scale next >
Lisp/Scheme  |  1998-10-26  |  3KB  |  76 lines
  1. (defun make-beth-scale (base divider n)
  2.    (let (out)
  3.      (dotimes (i n)
  4.        (push (compress (list (roundup (* (1+ i) (/ base divider))) '/ base)) out))
  5.      (nreverse out)))
  6.  
  7. (make-beth-scale 960 40 60)
  8. --> (24/960 48/960 72/960 96/960 120/960 144/960 168/960 192/960 216/960 
  9. 240/960 264/960 288/960 312/960 336/960 360/960 384/960 408/960 432/960 
  10. 456/960 480/960 504/960 528/960 552/960 576/960 600/960 624/960 648/960 
  11. 672/960 696/960 720/960 744/960 768/960 792/960 816/960 840/960 864/960 
  12. 888/960 912/960 936/960 960/960 984/960 1008/960 1032/960 1056/960 1080/960 
  13. 1104/960 1128/960 1152/960 1176/960 1200/960 1224/960 1248/960 1272/960 
  14. 1296/960 1320/960 1344/960 1368/960 1392/960 1416/960 1440/960)
  15.  
  16. defining tonality
  17.  
  18. (create-tonality n/40 (make-beth-scale 960 40 60))
  19.  
  20. using n/40
  21.  
  22. (activate-tonality (n/40 c 4 1000))
  23.  
  24. (make-beth-scale 960 23 60)
  25. --> (42/960 83/960 125/960 167/960 209/960 250/960 292/960 334/960 376/960 
  26. 417/960 459/960 501/960 543/960 584/960 626/960 668/960 710/960 751/960 
  27. 793/960 835/960 877/960 918/960 960/960 1002/960 1043/960 1085/960 1127/960 
  28. 1169/960 1210/960 1252/960 1294/960 1336/960 1377/960 1419/960 1461/960 
  29. 1503/960 1544/960 1586/960 1628/960 1670/960 1711/960 1753/960 1795/960 
  30. 1837/960 1878/960 1920/960 1962/960 2003/960 2045/960 2087/960 2129/960 
  31. 2170/960 2212/960 2254/960 2296/960 2337/960 2379/960 2421/960 2463/960 
  32. 2504/960))
  33.  
  34. Here is a version which finds the most pretty m/n ratio.
  35.  
  36. (defun make-beth-scale2 (base divider n)
  37.    (let (out ratio)
  38.      (dotimes (i n)
  39.        (setq ratio (rationalize (/ (roundup (* (1+ i) (/ base divider))) base)))
  40.        (if (integerp ratio)
  41.          (push (compress (list ratio '/ 1)) out)
  42.          (push ratio out)))
  43.      (nreverse out)))
  44.  
  45. (make-beth-scale2 960 23 60)
  46. --> (7/160 83/960 25/192 167/960 209/960 25/96 73/240 167/480 47/120 139/320 
  47. 153/320 167/320 181/320 73/120 313/480 167/240 71/96 751/960 793/960 167/192 
  48. 877/960 153/160 1/1 167/160 1043/960 217/192 1127/960 1169/960 121/96 313/240 
  49. 647/480 167/120 459/320 473/320 487/320 501/320 193/120 793/480 407/240 167/96 
  50. 1711/960 1753/960 359/192 1837/960 313/160 2/1 327/160 2003/960 409/192 2087/960 
  51. 2129/960 217/96 553/240 1127/480 287/120 779/320 793/320 807/320 821/320 313/120)
  52.  
  53. Here is a version that has no rounding errors and it returns the most pretty
  54. ratios.
  55.  
  56. (defun make-beth-scale3 (base divider n)
  57.    (let (out ratio)
  58.      (dotimes (i n)
  59.        (setq ratio (rationalize (/ (* (1+ i) (/ base divider)) base)))
  60.        (if (integerp ratio)
  61.          (push (compress (list ratio '/ 1)) out)
  62.          (push ratio out)))
  63.      (nreverse out)))
  64.  
  65. (make-beth-scale3 960 21 60)
  66. --> (1/21 2/21 1/7 4/21 5/21 2/7 1/3 8/21 3/7 10/21 11/21 4/7 13/21 2/3 5/7 16/21 
  67. 17/21 6/7 19/21 20/21 1/1 22/21 23/21 8/7 25/21 26/21 9/7 4/3 29/21 10/7 31/21 32/21 
  68. 11/7 34/21 5/3 12/7 37/21 38/21 13/7 40/21 41/21 2/1 43/21 44/21 15/7 46/21 47/21 
  69. 16/7 7/3 50/21 17/7 52/21 53/21 18/7 55/21 8/3 19/7 58/21 59/21 20/7)
  70.  
  71. ;; copy all the defun function definitions above into a separate file
  72. and then store the file into the environment/extensions folder. Now these
  73. functions will be automatically defined each time you start up SCOM, and
  74. you can call the functions immediately.
  75.  
  76.